home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byt86jun.arc / FRACTAL.ARC / RANDOM.BAS < prev    next >
Encoding:
BASIC Source File  |  1986-02-26  |  3.3 KB  |  110 lines
  1. 1 REM RANDOM.BAS is in MSX BASIC with MUSIC MACRO
  2. 2 REM commands for the Yamaha CX5-M music computer
  3. 4      REM
  4. 5      REM*******************************************************
  5. 6      REM    Copyright 1986   Charles Dodge, North Cape Music
  6. 7      REM*******************************************************
  7. 8      REM
  8. 10     CLS
  9. 20     DIM AP(10):DIM BP(100):DIM CP(255):DIM DP(2,255):TC=20
  10. 30     DIM BD(10):DIM CD(100):DIM DD(255)
  11. 40     DT=0:DC=0:CC=0:BC=0:AC=0:DIM CT(4)
  12. 50     DIM CF(4,12):DIM LAST(4):KN=50
  13. 60     X=RND(-TIME):LAST(1)=INT(RND(1)*32)
  14. 70     _INIT:_INST(1):_INST(2):_INST(3):_INST(4)
  15. 80     _MODI(1,5):_MODI(2,40):_MODI(3,15):_MODI(4,16)
  16. 100    FOR LOOP = 1 TO 4
  17. 110    PRINT"ENTER PITCH CLASS LIMIT OF LEVEL #";LOOP
  18. 120    INPUT PL(LOOP)
  19. 130    IF PL(LOOP)>6 THEN PRINT"TOO BIG":GOTO 120
  20. 140    IF PL(LOOP)<1 THEN PRINT"TOO SMALL":GOTO 120
  21. 150    NEXT LOOP
  22. 160    L=1
  23. 170    FOR A = 1 TO 10
  24. 180    GOSUB 820
  25. 190    IF CT(L)>PL(L) THEN GOTO 230
  26. 200    AC=AC+1
  27. 210    AP(A)=LAST(L)
  28. 220    NEXT
  29. 230    REM   FRACTAL ROUTINE
  30. 240    SCREEN 2
  31. 250    FOR A = 1 TO AC
  32. 260    CIRCLE(DI/2,197-(AP(A)*5+20)),9
  33. 270    LAST(2)=AP(A)
  34. 280    FOR B = 1 TO 10
  35. 290    L=2
  36. 300    GOSUB 820
  37. 310    IF CT(L)>PL(L) THEN GOTO 570
  38. 320    BI=BI+1:BP(BI)=LAST(L)
  39. 330    CIRCLE(DI/2,197-(BP(BI)*5+20)),6
  40. 340    LAST(3)=BP(BI)
  41. 350    FOR C = 1 TO 10
  42. 360    L=3
  43. 370    GOSUB 820
  44. 380    IF CT(L)>PL(L) THEN GOTO 550
  45. 390    CI=CI+1:CP(CI)=LAST(L):IF CI=255 THEN AC=A:GOTO 590
  46. 400    CIRCLE(DI/2,197-(CP(CI)*5+20)),3
  47. 410    LAST(4)=CP(CI)
  48. 420    FOR D = 1 TO 10
  49. 430    L=4
  50. 440    GOSUB 820
  51. 450    IF CT(L)>PL(L) THEN GOTO 530
  52. 460    DI=DI+1
  53. 470    CIRCLE(DI/2,197-(LAST(L)*5+20)),.5
  54. 480    IF DI>255 THEN GOTO 500
  55. 490    DP(1,DI)=LAST(L):GOTO 520
  56. 500    DP(2,DI-255)=LAST(L)
  57. 510    IF DI=510 THEN AC = A: GOTO 590
  58. 520    DC=DC+1:NEXT D
  59. 530    DD(CI)=DC:DC=0:CT(L)=0:GOSUB 1020
  60. 540    CC=CC+1:NEXT C
  61. 550    CD(BI)=CC:CC=0:CT(L)=0:GOSUB 1020
  62. 560    BC=BC+1:NEXT B
  63. 570    BD(A)=BC:BC=0:CT(L)=0:GOSUB 1020
  64. 580    NEXT A
  65. 590    LINE (0,0)-(255,0):LINE (255,0)-(255,197):
  66.        LINE(255,197)-(0,197):LINE(0,197)-(0,0)
  67. 600    DD$=INKEY$:IF DD$="" GOTO 600
  68. 610    REM    PLAY LOOPS
  69. 640    FOR A = 1 TO AC
  70. 650    _SOUND(1,1,AP(A)+KN)
  71. 660    FOR B = 1 TO BD(A):BC=BC+1
  72. 670    _SOUND(2,1,BD(BC)+KN)
  73. 680    FOR C = 1 TO CD(B):CC=CC+1
  74. 690    IF CC>255 GOTO 770
  75. 700    _SOUND(3,1,(CP(CC)+KN)
  76. 710    FOR D = 1 TO DD(C):DC=DC+1
  77. 720    IF DC>255 GOTO 740
  78. 730    _SOUND(4,1,DP(1,DC)+KN):GOTO 760
  79. 740    _SOUND(4,1,DP(2,DC-255)+KN)
  80. 750    IF DC=510 THEN GOTO 770
  81. 760    NEXT D:NEXT C:NEXT B:NEXT A
  82. 770    _STOP(1):_STOP(2):_STOP(3):_STOP(4)
  83. 780    DD$=INKEY$:IF DD$="" GOTO 780
  84. 790    BC=0:CC=0:DC=0
  85. 800    GOTO 610
  86. 820    REM      1/F ROUTINE
  87. 830    LL=LAST(L):NP=0:K=16:PROBIT=.03125
  88. 840    J=INT(LL/K)
  89. 850    IF J=1 THEN LL=LL-K
  90. 860    U=RND(1)
  91. 870    IF U<PROBIT THEN J=1-J
  92. 880    NP=NP+J*K
  93. 890    K=K/2
  94. 900    PROBIT = PROBIT*2
  95. 910    IF K>=1 GOTO 840
  96. 920    LAST(L)=NP:TEST=NP
  97. 930    REM     PITCH CLASS TEST
  98. 940    FOR I = 0 TO 11
  99. 950    IF INT((TEST+I)/12)=(TEST+I)/12
  100.     THEN CF(L,I)=1:GOTO 920
  101. 960    NEXT I
  102. 970    CT(L)=0
  103. 980    FOR I = 0 TO 11
  104. 990    CT(L)=CF(L,I)+CT(L)
  105. 1000   NEXT I
  106. 1010   RETURN
  107. )=1:GOTO 920
  108. 960    NEXT I
  109. 970    CT(L)=0
  110. 980